home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / tbbs / prgsourc.zip / FLAGS.ZIP / SYSFLAG.PRG < prev    next >
Text File  |  1996-03-03  |  7KB  |  376 lines
  1. SET EXCLUSIVE ON
  2. SET FORMAT TO fscr NOCLEAR
  3. SET INTENSITY OFF
  4. SELECT a
  5. USE ail INDEX ails
  6. SELECT b
  7. USE vflags INDEX pik
  8.  
  9.  
  10. DO Menu
  11.  
  12. k= " "
  13. SET COLOR TO N/N
  14. @ 0,0 GET k
  15. DO WHILE .T.
  16.    READ
  17.    DO CASE
  18.       
  19.       CASE LastKey() = 27 
  20.            QUIT
  21.       
  22.       CASE LastKey() = 65 .OR. LastKey() = 97        && A 0R a .AIL
  23.            @ 0,0 CLEAR
  24.            DO Block
  25.            DO Menu
  26.         
  27.       CASE LastKey() = 70 .OR. LastKey() = 102       && F 0R f Files
  28.            @ 0,0 CLEAR
  29.            DO Flagview
  30.            DO Menu
  31.  
  32.       CASE LastKey() = 73 .OR. LastKey() = 105       && I 0R i Index
  33.            @ 0,0 CLEAR
  34.            DO Inx
  35.            DO Menu
  36.       
  37.       CASE LastKey() = 76 .OR. LastKey() = 108       && L 0R l List files
  38.            @ 0,0 CLEAR
  39.            DO Filelist
  40.            DO Menu
  41.    
  42.  
  43.  
  44.    ENDCASE
  45. ENDDO
  46. QUIT
  47.  
  48. **************************************************
  49. PROCEDURE Inx
  50.  
  51. SET COLOR TO W+/N
  52. txt = "textfile"
  53. @ 1,5 SAY "Enter the name of the text file (no path or extension)" 
  54. @ 2,5 SAY "to index: "
  55. SET COLOR TO GR+/N
  56. @ 2,15 GET txt PICTURE "@K!"
  57. READ
  58.  
  59. SET COLOR TO W+/N
  60.  
  61. SEEK txt
  62. IF .NOT. Found()
  63.    APPEND BLANK
  64.    REPLACE pfile WITH txt
  65. ENDIF
  66.  
  67. txt = homepath() + "PIKS\" + RTrim(txt) + ".TXT"
  68.  
  69. b = fMaxLen()
  70. IF b > 5120
  71.    tb = 2048
  72.    pb = 2048
  73. ELSE
  74.    IF buf > 3072
  75.       tb = 1024
  76.       pb = 1024
  77.    ELSE
  78.       IF buf > 512
  79.          tb = 256
  80.          pb = 256
  81.       ELSE
  82.          tb = 0 
  83.          pb = 0
  84.       ENDIF
  85.    ENDIF
  86. ENDIF
  87.  
  88.  
  89. FOPEN t (txt) 10 tb
  90. IF t < 0
  91.    DO er WITH 1
  92. ENDIF
  93.  
  94. @ 4,5 SAY "Examining file..."
  95.  
  96. pmax = 1
  97. lines = 0
  98.  
  99. DO WHILE .T.
  100.    FLREAD t tm line
  101.    IF tm > 0
  102.       line = LTrim(RTrim(CRTrim(line)))
  103.       n = Len(line)
  104.       IF n = 0
  105.          EXIT
  106.       ENDIF
  107.       IF n > pmax
  108.          pmax = n
  109.       ENDIF
  110.    ELSE 
  111.       EXIT
  112.    ENDIF
  113.    lines = lines + 1
  114. ENDDO
  115.  
  116. @ 6,5 SAY "Number of lines in file:"
  117. SET COLOR TO GR+/N
  118. @ 6,31 SAY LTrim(Str(lines))
  119. SET COLOR TO W+/N
  120.  
  121. IF lines > 15876
  122.    DO er WITH 2
  123. ENDIF
  124.  
  125. @ 8,5 SAY "Creating .PIK file..."
  126.  
  127. txt = Stuff(txt,Len(txt)-2,3,"PIK")
  128.  
  129. FCREATE p (txt) 13 0 pb
  130. IF p < 0
  131.    DO er WITH 3
  132. ENDIF
  133.  
  134. FSEEK t tp 0 0
  135.  
  136. x = 0
  137. DO WHILE .T.
  138.    FLREAD t tm line
  139.    IF tm > 0
  140.       line = LTrim(RTrim(CRTrim(line)))
  141.       p1 = Len(line)
  142.       IF p1 = 0
  143.          EXIT
  144.       ENDIF
  145.       IF pmax = p1
  146.          line = line + Chr(13) + Chr(10)
  147.       ELSE
  148.          line = line + Replicate(Chr(32),pmax-p1) + Chr(13) + Chr(10)
  149.       ENDIF
  150.       p1 = Len(line)
  151.       IF x = 0
  152.          Oldp1 = p1
  153.       ENDIF
  154.       IF p1 # Oldp1
  155.          DO er WITH 4
  156.       ENDIF
  157.       FLWRITE p pm line
  158.       IF pm < 1
  159.          DO er WITH 5
  160.       ENDIF
  161.       x = x + 1
  162.    ELSE
  163.      EXIT
  164.    ENDIF
  165. ENDDO
  166.  
  167. IF lines # x
  168.    DO er WITH 6
  169. ENDIF
  170.  
  171. REPLACE plen WITH x
  172. REPLACE pwidth WITH Oldp1
  173.  
  174. IF x > 126
  175.    REPLACE flen WITH 2
  176. ELSE
  177.    REPLACE flen WITH 1
  178. ENDIF
  179.  
  180. @ 10,5 SAY "Flag will use" 
  181. SET COLOR TO GR+/N
  182. @ 10,19 SAY LTrim(Str(flen))  
  183. SET COLOR TO W+/N
  184. IF flen = 1
  185.    @ 10,21 SAY "flag position."
  186. ELSE
  187.    @ 10,21 SAY "flag positions."
  188. ENDIF
  189.  
  190. @ 11,5 SAY "Enter the initial flag position:"
  191. SET COLOR TO GR+/N
  192. @ 11,38 GET fpos PICTURE "@KZB 99"
  193. READ
  194.  
  195. FCLOSE p
  196.  
  197. SET COLOR TO W+/N
  198. @ 13,5 SAY "Flag file indexing completed." 
  199. SET COLOR TO GR+/N
  200. @ 14,15 SAY "<ANY KEY>"
  201. k = InKey(40)
  202. RETURN
  203.  
  204. **************************************************
  205. PROCEDURE er
  206. PARAMETERS e
  207.  
  208. DO CASE
  209.    CASE e = 1
  210.         err = "Error opening .TXT file."
  211.    CASE e = 2
  212.         err = "Maximum 15,876 items in list. List too long."
  213.    CASE e = 3
  214.         err = "Error creating .PIK file."
  215.    CASE e = 4      
  216.         err = "Error formatting .PIK file."
  217.    CASE e = 5           
  218.         err = "Error writing to .PIK file."
  219.    CASE e = 6           
  220.         err = "Error in length of .PIK file." 
  221. ENDCASE
  222. SET COLOR TO W+/N
  223. @ 10,5 SAY err
  224. SET COLOR TO GR+/N
  225. @ 11,5 SAY "<ANY KEY>"
  226. k = InKey (30)
  227. QUIT
  228.  
  229. RETURN
  230.  
  231. **************************************************
  232. PROCEDURE Filelist
  233.  
  234. SET COLOR TO W+/N
  235.  
  236. mask = HomePath() + "PIKS\*.*"
  237. f1 = FindFirst(fil,(mask))
  238. @ 1,5 SAY f1
  239. x = 1
  240. DO WHILE Len(f1) > 0
  241.    f1 = FindNext(fil)
  242.    @ 1+x,5 SAY f1
  243.    x = x +1
  244. ENDDO
  245.  
  246. @ Row()+2,5 SAY "<ANY KEY>"
  247. k = Inkey(0)
  248. RETURN
  249.  
  250. **************************************************
  251. PROCEDURE Menu
  252. SET COLOR TO N/N
  253. @ 0,0 CLEAR
  254. SET COLOR TO W+/N
  255. @ 0,5 SAY "<A> Block .AIL" 
  256. @ 1,5 SAY "<F> View flag positions"
  257. @ 2,5 SAY "<I> Index .TXT file to .PIK file"
  258. @ 3,5 SAY "<L> List files in \PIKS subdirectory"
  259. @ 4,5 SAY "<Esc> Quit"
  260. RETURN
  261.  
  262. **************************************************
  263. PROCEDURE Flagview
  264.  
  265. SET COLOR TO W+/N
  266. COUNT TO cnt
  267. GOTO TOP
  268.    
  269. @ 1,2 SAY  "File/Identifier"
  270. @ 1,22 SAY "F. Position"
  271. @ 1,35 SAY "F. Length"
  272. @ 1,47 SAY "Length of line"
  273. @ 1,62 SAY "Length of File"
  274.  
  275. x = 1
  276. DO WHILE .T.
  277.    @ x+2,5 SAY pfile
  278.    @ x+2,25 SAY LTrim(Str(fpos))
  279.    @ x+2,37 SAY LTrim(Str(flen))
  280.    @ x+2,49 SAY LTrim(Str(pwidth))
  281.    @ x+2,65 SAY LTrim(Str(plen))
  282.    IF x = cnt
  283.       EXIT
  284.    ENDIF
  285.    SKIP
  286.    x = x + 1
  287. ENDDO
  288.  
  289. @ Row()+2,5 SAY "<ANY KEY>"
  290. k = Inkey(0)
  291. RETURN
  292.  
  293.  
  294. PROCEDURE Block
  295.  
  296. SELECT a
  297. SET COLOR TO W+/N
  298. COUNT TO cnt
  299. GOTO TOP
  300.  
  301. @ 1,22 SAY ".AIL File"
  302. @ 1,47 SAY "Blocked"
  303.  
  304. x = 1
  305. DO WHILE .T.
  306.    @ x+2,25 SAY ail
  307.    IF blocked
  308.       @ x+2,49 SAY "Blocked"
  309.    ELSE
  310.       @ x+2,49 SAY "Open"
  311.    ENDIF
  312.    IF x = cnt
  313.       EXIT
  314.    ENDIF
  315.    SKIP
  316.    x = x + 1
  317. ENDDO
  318. x = 1
  319.  
  320. GOTO TOP
  321. SET COLOR TO GR+/B
  322. @ x+2,25 SAY ail
  323.  
  324. k= " "
  325. SET COLOR TO N/N
  326. @ 0,0 GET k
  327. DO WHILE .T.
  328.    READ
  329.    SET COLOR TO W+/N
  330.    DO CASE
  331.       
  332.       CASE LastKey() = 24                           && Up
  333.            IF x = 1
  334.               LOOP
  335.            ENDIF
  336.            
  337.            @ x+2,25 SAY ail
  338.            
  339.            x = x - 1
  340.            SKIP -1
  341.  
  342.            SET COLOR TO GR+/B
  343.            @ x+2,25 SAY ail
  344.            
  345.  
  346.       CASE LastKey() = 24                           && Down
  347.            IF x = cnt
  348.               LOOP
  349.            ENDIF
  350.            
  351.            @ x+2,25 SAY ail
  352.            
  353.            x = x + 1
  354.            SKIP
  355.  
  356.            SET COLOR TO GR+/B
  357.            @ x+2,25 SAY ail
  358.  
  359.  
  360.       CASE LastKey() = 27                     && <Esc> = 
  361.            EXIT
  362.       
  363.       CASE LastKey() = 13                     && <Enter> = Block
  364.            IF blocked
  365.               REPLACE blocked WITH .F.
  366.               @ x+2,49 SAY "Open"
  367.            ELSE
  368.               REPLACE blocked WITH .T.
  369.               @ x+2,49 SAY "Blocked"
  370.            ENDIF
  371.       
  372.    ENDCASE
  373. ENDDO
  374. SELECT b
  375. RETURN
  376.